home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ftpget1r / mczip.bas < prev    next >
BASIC Source File  |  1997-07-26  |  6KB  |  215 lines
  1. Attribute VB_Name = "mcZIP"
  2. Option Explicit
  3.  
  4. '  Name:       mcZIP
  5. '  Version:    0.80▀
  6. '  Date:       97-07-26
  7. '  Author:     Martin Carlsson (martin@comports.com)
  8. '  Homepage:   http://www.algonet.se/~mmcc/
  9. '
  10. '  This little .BAS-file contains procedures and functions to list the contents of
  11. '  files compressed with PKZip, ARJ and LHA/LZH.
  12. '
  13. '  Call like this:
  14. '
  15. '        AddZIPFiles Filename, ListBox
  16. '
  17. '        where Filename is the ZIP-file and
  18. '              ListBox is the listbox where mcZIP will put the file info
  19. '
  20. '        example: AddZIPFiles "C:\TEST.ZIP", lstZIPFiles
  21. '
  22. '  The syntax for AddARJfiles and AddLZHfiles is just the same.
  23. '
  24. '  If you'd like to use the code for anything more useful than the sample application you
  25. '  most likely will have to rewrite some parts of the code... but that's not a problem, right?!
  26. '
  27. '  This file is provided "AS IS". You can't hold me responsible for any damage that might 
  28. '  occur by using this code in any way. When distributing this sourcecode, all the
  29. '  original files and this notice must be included. Please do not distribute modified versions.
  30. '
  31. '  This is freeware. You may even use it for free in your commercial products, but please
  32. '  include a small notice like "Parts of this program written by Martin Carlsson" or at least
  33. '  send me an e-mail. Thank you.
  34. '
  35. '  Copyright ⌐ 1997 Martin Carlsson
  36.  
  37. Private Type ZFHeader
  38.    Signature      As Long
  39.    version        As Integer
  40.    GPBFlag        As Integer
  41.    Compress       As Integer
  42.    Date           As Integer
  43.    Time           As Integer
  44.    CRC32          As Long
  45.    CSize          As Long
  46.    USize          As Long
  47.    FNameLen       As Integer
  48.    ExtraField     As Integer
  49. End Type
  50.  
  51. Private Type ARJmainheader
  52.    id             As Integer
  53.    headersize     As Integer
  54.    firsthdrsize   As Byte
  55.    version        As Byte
  56.    minversion     As Byte
  57.    archiveos      As Byte
  58.    flags          As Byte
  59.    secversion     As Byte
  60.    filetype       As Byte
  61.    x_reserved     As Byte
  62.    createtime     As Long
  63.    modifytime     As Long
  64.    FileSize       As Long
  65.    secenvpos      As Long
  66.    filespecpos    As Integer
  67.    secenvlength   As Integer
  68.    x_notused      As Integer
  69. End Type
  70.  
  71. Private Type ARJlocalheader
  72.    id             As Integer
  73.    headersize     As Integer
  74.    firsthdrsize   As Byte
  75.    version        As Byte
  76.    minversion     As Byte
  77.    archiveos      As Byte
  78.    flags          As Byte
  79.    method         As Byte
  80.    filetype       As Byte
  81.    x_reserved     As Byte
  82.    datemodify     As Long
  83.    sizecompr      As Long
  84.    sizeorig       As Long
  85.    origcrc        As Long
  86.    filespecpos    As Integer
  87.    accessmode     As Integer
  88.    hostdata       As Integer
  89. End Type
  90.  
  91. Private Type LZHheader
  92.    headersize     As Byte
  93.    remaincrc      As Byte
  94.    id             As String * 3
  95.    method         As String * 1
  96.    id2            As String * 1
  97.    sizecompr      As Long
  98.    sizeorig       As Long
  99.    filedate       As Long
  100.    fileattrib     As Integer
  101.    filenamelen    As Byte
  102. End Type
  103.  
  104. Private Function StripGarbage(ByVal str As String) As String
  105. Dim sTmp As String, ch As String * 1, i As Integer
  106.  
  107.    For i = 1 To Len(str)
  108.       ch = Mid$(str, i, 1)
  109.       If ch <> Chr$(0) Then
  110.          sTmp = sTmp & ch
  111.       Else
  112.          StripGarbage = sTmp
  113.          Exit Function
  114.       End If
  115.    Next
  116.  
  117. End Function
  118.  
  119.  
  120. Public Sub AddLZHfiles(LZHfile As String, LBox As ListBox)
  121. Dim FNum As Integer, LZHrec As LZHheader, NameStr As String
  122.  
  123.    FNum = FreeFile
  124.    Open LZHfile For Binary Lock Write As #FNum
  125.  
  126.    Do
  127.       If (Loc(FNum) + Len(LZHrec)) > LOF(FNum) Then Exit Do
  128.       Get FNum, , LZHrec
  129.       If Left$(LZHrec.id, 2) = "-l" Then
  130.          NameStr = Space$(LZHrec.filenamelen)
  131.          Get FNum, , NameStr
  132.             
  133.          LBox.AddItem Trim$(NameStr) & Chr$(9) & Chr$(9) & LZHrec.sizeorig
  134.          
  135.          Seek FNum, Loc(FNum) + 2 + LZHrec.sizecompr + 4
  136.       End If
  137.    Loop Until EOF(FNum)
  138.  
  139.    Close FNum
  140.  
  141. End Sub
  142.  
  143.  
  144. Public Sub AddARJfiles(ARJfile As String, LBox As ListBox)
  145. Dim FNum As Integer, ARJrec As ARJmainheader, FILrec As ARJlocalheader, FPos As Long
  146. Dim NameStr As String * 256
  147.  
  148.    FNum = FreeFile
  149.    Open ARJfile For Binary Lock Write As #FNum
  150.  
  151.    Get FNum, , ARJrec
  152.    If ARJrec.id = -5536 Then
  153.       Seek FNum, ARJrec.headersize + 11
  154.       
  155.       Do
  156.          If (Loc(FNum) + Len(FILrec)) > LOF(FNum) Then Exit Do
  157.          FPos = Loc(FNum)
  158.          Get FNum, , FILrec
  159.          If FILrec.id = -5536 Then
  160.             Get FNum, , NameStr
  161.             NameStr = StripGarbage(NameStr)
  162.                   
  163.             LBox.AddItem Trim$(NameStr) & Chr$(9) & Chr$(9) & FILrec.sizeorig
  164.             
  165.             Seek FNum, FPos
  166.             Seek FNum, Loc(FNum) + FILrec.headersize + 12 + FILrec.sizecompr
  167.          End If
  168.       Loop Until EOF(FNum)
  169.    End If
  170.       
  171.    Close FNum
  172.  
  173. End Sub
  174.  
  175.  
  176. Public Sub AddZIPfiles(ByVal ZIPfile As String, LBox As ListBox)
  177. Dim FNum As Integer, sRet As String
  178. Dim iCounter As Integer, sResult As String
  179. Dim zhdr As ZFHeader
  180.  
  181. Const ZIPSIG = &H4034B50
  182.      
  183.    FNum = FreeFile
  184.    Open ZIPfile For Binary Lock Read Write As #FNum
  185.    Get #FNum, , zhdr
  186.  
  187.    While zhdr.Signature = ZIPSIG
  188.       ReDim s(0 To zhdr.FNameLen - 1) As String * 1
  189.       For iCounter = 0 To UBound(s)
  190.          s(iCounter) = Chr$(0)
  191.       Next
  192.       
  193.       For iCounter = 0 To zhdr.FNameLen - 1
  194.         Get #FNum, , s(iCounter)
  195.       Next
  196.  
  197.       Seek #FNum, Seek(FNum) + zhdr.CSize + zhdr.ExtraField
  198.  
  199.       sResult = ""
  200.  
  201.       For iCounter = 0 To UBound(s)
  202.         sResult = sResult & s(iCounter)
  203.       Next
  204.  
  205.       LBox.AddItem sResult & Chr$(9) & Format$(zhdr.USize)
  206.          
  207.       Get #FNum, , zhdr
  208.    Wend
  209.  
  210.    Close FNum
  211.    
  212. End Sub
  213.  
  214.  
  215.